COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY
C00003 00003	!	define reserved token codes 
C00015 00004	!	tables to set up reserved words 
C00018 00005	! 	decoding a token to give its various parameters 
C00020 00006	!	procedure parse itself
C00025 00007	!	preparse
C00026 ENDMK
C⊗;
ENTRY;
BEGIN "PARSE"
DEFINE $$PRGID=TRUE;	DEFINE $PARSE=TRUE;	
REQUIRE "HEADER.SAI" SOURCE_FILE;

DEFINE #TOP=1;	! complain if $COMPILE≠0;
DEFINE #NEXPND=2; ! sets NOEXPAND←TRUE;
DEFINE #CMPD=4;	! set $COMPILE ← $COMPILE + 1 ;
DEFINE #NOTTOP='10;	! complain if $COMPILE=0 ;
DEFINE #SEMICOL='20;	! do a semicolonread;
DEFINE #DEBUG='40;	! complain if ¬!!debugging;
!	define reserved token codes ;

!	format is as follows:
	ZZ(symbol, opcode number, precedence level)	for operators
	XX(flag,  statement reserved word,  parsing procedure to call)
				where flag indicates whether this statement
				is available in the current version
	XXZZ(flag, symbol, parsing procedure, opcode number, precedence level)
				for symbols which are both operators and
				first words of statements ;
define tokencodes "[][]" =[
ZZ("↓",		DOWNARROW_X,	PF_XX,	0)
ZZ("∧",		and_X,		BFACT_XX,	0)
ZZ("¬",		not_X,		PF_XX,	0)
ZZ("⊗",		xor_X,		BEFACT_XX,	0)
ZZ("→",		frontarrow_X,	FACTOR_XX,	0)
ZZ("≠",		sne_X,		BTERM_XX,	0)
ZZ("≤",		sle_X,		BTERM_XX,	0)
ZZ("≥",		sge_X,		BTERM_XX,	0)
ZZ("≡",		eqv_X,		EXP_XX,	0)
ZZ("∨",		or_X,		BEFACT_XX,	0)
ZZ("#",		pplus_X,	AEXP_XX,	0)
ZZ("$",		DOLLAR_X,	PF_XX,	0)
ZZ("α",		ALPHA_X,	PF_XX,	0)
ZZ(["("],	LPAREN_X,	PF_XX,	0)
ZZ("*",		times_X,	TERM_XX,	0)
ZZ("+",		Plus_X,		AEXP_XX,	0)
ZZ("-",		minus_X,	AEXP_XX,	0)
ZZ(".",		vdot_X,		TERM_XX,	0)
ZZ("/",		sdiv_X,		TERM_XX,	0)
ZZ("<",		slt_X,		BTERM_XX,	0)
ZZ("=",		seq_X,		BTERM_XX,	0)
ZZ(">",		sgt_X,		BTERM_XX,	0)
XX(TRUE,	ABORT,		ABORTPROC,	0)
ZZ("ACOS",	acos_X,		PF_XX,	0)
XX(TRUE,	AFFIX,		AFFIXPROC,	0)
XX(TRUE,	ALL,		NOTAVAILCALL,	0)
ZZ("AND",	aand_X,		BFACT_XX,	0)
XX(TRUE,	APPROACH,	NOTAVAILCALL,	0)
XX(TRUE,	ARRAY,		NOTAVAILCALL,	0)
ZZ("ASIN",	asin_X,		PF_XX,	0)
ZZ("ATAN2",	atan2_X,	PF_XX,	0)
ZZ("AXIS",	axis_X,		PF_XX,	0)
XX(TRUE,	BAIL,		BAILCALL,	0)
XX(TRUE,	BEGIN,		BEGINPROC,	#CMPD)
	XX(TRUE,	BREAK,		BREAKDEBUG(TRUE),	#DEBUG+#TOP)
XX(#MOVE,	BY,		BYPROC,		0)
XX(TRUE,	CASE,		CASEPROC,	#CMPD)
XX(#MOVE,	CENTER,		CENTERPROC,	0)
XX(TRUE,	CLOCKWISE,	NOTAVAILCALL,	0)
XX(#MOVE,	CLOSE,		OPENPROC(FALSE),	0)
XX(TRUE,	COBEGIN,	COBEGINPROC,	#CMPD)
XX(TRUE,	COEND,		ENDPROC("COEND"),	#NOTTOP)
XX(TRUE,	COMMENT,	[READTO(";")],	0)
XX(FALSE,	CONSOLE,	NOTAVAILCALL,	0)
ZZ("CONSTRUCT",	construct_X,	PF_XX,	0)
ZZ("COS",	cos_X,		PF_XX,	0)
XX(TRUE,	COUNTER_CLOCKWISE,	NOTAVAILCALL,	0)
XX(TRUE,	DDT,		DDTPROC,	0)
XX(TRUE,	DEFINE,		DEFINECALL,	#NEXPND)
XX(TRUE,	DELETE,		DELETECALL,	#NEXPND)
XX(TRUE,	DEPARTURE,	NOTAVAILCALL,	0)
XX(TRUE,	DISABLE,	ENBLEPROC(FALSE),	0)
XX(#DISPL,	DISPLAY,	DISPLAYCALL,	#TOP+#NEXPND)
ZZ("DIV",	div_X,		TERM_XX,	0)
XX(TRUE,	DO,		DOPROC,		#CMPD)
XX(#MOVE,	DRIVE,		DRIVEPROC,	0)
XX(TRUE,	DUMP_VARIABLES,	DUMPPROC(NAME_OF_FILE),	#TOP)
XX(TRUE,	DURATION,	NOTAVAILCALL,	0)
XX(TRUE,	ECHOOFF,	[FILEPRINT←FALSE],	0)
XX(TRUE,	ECHOON,		[FILEPRINT←TRUE],	0)
XX(TRUE,	EDIT,		EDITCALL,	#TOP+#NEXPND)
XX(TRUE,	EEDIT,		EEDITCALL,	#TOP+#NEXPND)
XX(TRUE,	ENABLE,		ENBLEPROC(TRUE),	0)
XX(TRUE,	END,		ENDPROC,	#NOTTOP)
ZZ("EQV",	eeqv_X,		EXP_XX,	0)
XX(TRUE,	ERROR,		NOTAVAILCALL,	0)
comment ZZ("EVAL",	EVAL_X,		PF_XX,	0);
XX(TRUE,	EVENT,		DECLPROC(#EV),	0)
XX(TRUE,	EXIT,		EXITCALL,	#TOP+#SEMICOL)
ZZ("EXP",	exp_X,		PF_XX,	0)
XX(FALSE,	FCONSTRUCT,	FCONSTRUCTPROC,	0)
XX(TRUE,	FOR,		FORPROC,	#CMPD)
XX(TRUE,	FORCE,		NOTAVAILCALL,	0)
XXZZ(TRUE,	FRAME,	DECLPROC(#FR),	FRAME_X,	PF_XX,	0)
XX(not #nofunct,	FUNCTION,	FUNCTPROC,	0)
XX(#GATHER,	GATHER,		GATHERPROC,	0)
XX(#GATHER,	GRAPH,		GRAPHCALL,	#TOP)
	XX(TRUE,	HALT,		HALTDEBUG,	0)
XX(TRUE,	HELP,		HELPCALL,	0)
XX(TRUE,	IF,		IFPROC,		#CMPD)
ZZ("INSCALAR",	inscalar_X,	PF_XX,	0)
ZZ("INT",	int_X,		PF_XX,	0)
XX(TRUE,	INTO,		NOTAVAILCALL,	0)
ZZ("INV",	rinv_X,		PF_XX,	0)
XX(TRUE,	LABEL,		SIMPLEDECL(#CM),	0)
XX(TRUE,	LOAD_VARIABLES,	LOADPROC(NAME_OF_FILE),	#TOP)
ZZ("LOG",	log_X,		PF_XX,	0)
ZZ("MAX",	max_X,		TERM_XX,	0)
ZZ("MIN",	min_X,		TERM_XX,	0)
ZZ("MOD",	mod_X,		TERM_XX,	0)
XX(#MOVE,	MOVE,		MOVEPROC,	0)
XX(#MOVE,	MOVEX,		DELMOVEPROC(1),	0)
XX(#MOVE,	MOVEY,		DELMOVEPROC(2),	0)
XX(#MOVE,	MOVEZ,		DELMOVEPROC(3),	0)
XX(#DISPL,	NODISPLAY,	NODISPLAYCALL,	#TOP)
XX(#DISPL,	NOUPDATE,	[$ALLOW←$ALLOW+1],	#TOP)
XX(#MOVE,	ON,		ONPROC,	0)
XX(#MOVE,	OPEN,		OPENPROC,	0)
XX(#MOVE,	OPERATE,	OPERPROC,	0)
ZZ("OR",	oor_X,		BEFACT_XX,	0)
XXZZ(TRUE,	ORIENT,	COORDPROC(0,#RT),	ORIENT_X,	PF_XX,	0)
XX(#MOVE∧FALSE,	PARK,		PARKINGPROC,	0)
XX(TRUE,	PAUSE,		PAUSEPROC,	0)
XX(TRUE,	PHOTO,		PHOTOCALL(NAME_OF_FILE),	#TOP)
XXZZ(TRUE,	POS,	COORDPROC(0,#VT),	POS_X,	PF_XX,	0)
XX(TRUE,	PRINT,		PRINTPROC,	0)
XX(TRUE,	PROCEDURE,	PROCDECLPROC,	#CMPD+#TOP)
XX(TRUE,	PROMPT,		PROMPTPROC,	0)
XX(TRUE,	QBAIL,		QBLCALL,	0)
XX(TRUE,	QDELETE,	DELETECALL(TRUE),	#TOP+#NEXPND)
XX(#OUTPT,	QREAD,		READCALL(FALSE),	#TOP+#NEXPND)
ZZ("QUERY",	qquery_X,	PF_XX,		0)
XX(#OUTPT,	READ,		READCALL,	#TOP+#NEXPND)
XX(TRUE,	READMESSAGE,	READMESSCALL,	#TOP+#SEMICOL)
XX(#WRIST,	READWRIST,	READWRISTPROC,	#TOP)
XX(TRUE,	REDEFINE,	DEFINECALL(TRUE),	#NEXPND)
XX(#DISPL,	REDISPLAY,	REDISPLAYCALL,	#TOP)
XX(TRUE,	REFERENCE,	NOTAVAILCALL,	0)
ZZ("REL",	rel_X,		FACTOR_XX,	0)
XX(TRUE,	RENAME,		RENAMCALL,	#TOP+#NEXPND)
XX(TRUE,	REQUIRE,	REQUIRECALL,	0)
XX(TRUE,	RESETSTATUS,	SETSTATUSCALL(0),	#TOP)
	XX(TRUE,	RESTART,	RESTARTDEBUG,	#DEBUG+#TOP)
XX(TRUE,	RESUME_MESSAGE,	RSUMEMESSCALL,	#TOP)
XX(#MOVE,	RETRY,		RETRYPROC,	0)
XX(TRUE,	RETURN,		RETURNPROC,	#NOTTOP)
XXZZ(TRUE,	ROT,		DECLPROC(#RT),	ROT_X,	PF_XX,	0)
ZZ("RUNTIME",	runtime_X,		PF_XX,	0)
XX(TRUE,	SAVECOREIMAGE,	SAVECORECALL(NAME_OF_FILE),	#TOP)
XX(TRUE,	SCALAR,		DECLPROC(#SC),	0)
XX(TRUE,	SETBASE,	SETBASEPROC,	0)
XX(TRUE,	SETSTATUS,	SETSTATUSCALL(1),	#TOP+#NEXPND)
XX(TRUE,	SETSTIFF,	SETSTIFFPROC,	0)
XX(TRUE,	SHOW,		SHOWCALL,	#TOP+#NEXPND)
XX(TRUE,	SIGNAL,		SIGWAITPROC(TRUE),	0)
ZZ("SIN",	sin_X,		PF_XX,	0)
XX(TRUE,	SPEED_FACTOR,	SETSPEEDPROC,	0)
ZZ("SQRT",	sqrt_X,		PF_XX,	0)
XX(#MOVE,	STOP,		STOPPROC,	0)
XX(TRUE,	STOPMESSAGE,	STOPMESSCALL,	#TOP+#SEMICOL)
XX(TRUE,	STOP_WAIT_TIME,	NOTAVAILCALL,	0)
XX(TRUE,	SUBTREE,	NOTAVAILCALL,	0)
ZZ("TAN",	tan_X,		PF_XX,	0)
	XX(TRUE,	TEXT,		TEXTDEBUG,	#DEBUG+#TOP)
XX(#GATHER,	TGRAPH,		TGRAPHCALL,	#TOP)
XX(#MOVE,	TO,		TOPROC,		0)
XX(TRUE,	TORQUE,		NOTAVAILCALL,	0)
XXZZ(TRUE,	TRANS,		DECLPROC(#TR),	TRANS_X,	PF_XX,	0)
	XX(TRUE,	TRAPS,		TRAPSDEBUG,	#DEBUG+#TOP)
	XX(TRUE,	UNBREAK,	BREAKDEBUG(FALSE),	#DEBUG+#TOP)
XX(FALSE,	UNCONSOLE,	NOTAVAILCALL,	0)
XX(TRUE,	UNFIX,		UNFIXPROC,	0)
ZZ("UNIT",	uvect_X,	PF_XX,	0)
XX(#DISPL,	UPDATE,		[$ALLOW←$ALLOW-1],	0)
XX(TRUE,	VALUE,		NOTAVAILCALL,	0)
XXZZ(TRUE,	VECTOR,	DECLPROC(#VT),	VECTOR_X,	PF_XX,	0)
XX(TRUE,	VELOCITY,	NOTAVAILCALL,	0)
XX(TRUE,	VT05,		NOTAVAILCALL,	0)
XX(TRUE,	VT05_OFF,	VT05PROC(1),	0)
XX(TRUE,	VT05_ON,	VT05PROC(0),	0)
XX(TRUE,	WAIT,		SIGWAITPROC(FALSE),	0)
XX(TRUE,	WHILE,		WHILEPROC,	#CMPD)
XX(TRUE,	WRIST,		WRISTPROC,	0)
XX(#OUTPT,	WRITE,		WRITCALL,	#TOP+#NEXPND)
ZZ("WRT",	wrt_X,		FACTOR_XX,	0)
XXZZ(TRUE,	XCOORD,	COORDPROC(1,#SC),	COORDX_X,	PF_XX,	0)
XX(TRUE,	XFOO1,		FOOCALL(1),	0)
XX(TRUE,	XFOO2,		FOOCALL(2),	0)
XX(TRUE,	XFOO3,		FOOCALL(3),	0)
XX(TRUE,	XFOO4,		FOOCALL(4),	0)
XX(TRUE,	XFOO5,		FOOCALL(5),	0)
XX(TRUE,	XFOO6,		FOOCALL(6),	0)
XX(TRUE,	XFOO7,		FOOCALL(7),	0)
XX(TRUE,	XFOO8,		FOOCALL(8),	0)
XX(TRUE,	XFOO9,		FOOCALL(9),	0)
ZZ("XOR",	xxor_X,		BEFACT_XX,	0)
XXZZ(TRUE,	YCOORD,	COORDPROC(2,#SC),	COORDY_X,	PF_XX,	0)
XXZZ(TRUE,	ZCOORD,	COORDPROC(3,#SC),	COORDZ_X,	PF_XX,	0)
ZZ("↑",		stos_X,		FACTOR_XX,	0)
ZZ("|",		MAGNITUDE_X,	PF_XX,	0)
];

!	tables to set up reserved words ;

	! count number of reserved tokens ;
define res_count = 0;
redefine zz(symb,opnum,precedence_level)"[][]"=[redefine res_count=res_count+1;];
redefine xxzz(#flag,str,parsing_proc,opnum,precedence_level)"[][]"
		=[redefine res_count=res_count+1;];
redefine xx(#flag, str, parsing_proc)"[][]"=[redefine res_count=res_count+1;];

	! **************************************** ;
	! *****;	tokencodes;	! ******** ;
	! at this point res_count contains actual # of reserved words ;


	! set up a string array of reserved tokens  in RESCODE ;
redefine xx(#flag, str, parsing_proc)"[][]"=["str", ];
redefine xxzz(#flag,str,parsing_proc,opnum,precedence_level)"[][]"=["str",];
redefine zz(symb,opnum,precedence_level)"[][]"=[symb,];

preload_array( rescode , tokencodes , string , 1 , res_count);

	! set up an integer array of codes  for the reserved tokens ;
define xx_count=0;
redefine xx(#flag, str, parsing_proc)"[][]"=[
	redefine xx_count=xx_count+1; 
	xx_count*(#OPERATORS+1)*#DTYPE, ];
redefine zz(symb,opnum,precedence_level)=
	[opnum*#DTYPE+precedence_level,];
redefine xxzz(#flag,str,parsing_proc,opnum,precedence_level)"[][]"=[
	redefine xx_count=xx_count+1;
	(xx_count*(#OPERATORS+1)+opnum)*#DTYPE+precedence_level, ];

	! ***** now set up the array as TCODES  ***** ;
preload_array(tcodes, tokencodes, integer, 1, res_count);

redefine xx(#flag, str, parsing_proc,#cond)"[][]"=[#cond,];
redefine zz(symb,opnum,precedence_level,#cond)=[#cond,];
redefine xxzz(#flag,str,parsing_proc,opnum,precedence_level,#cond)"[][]"=[#cond,];

preload_array(ccodes,tokencodes,integer,1,res_count);
! 	decoding a token to give its various parameters ;
!	res_class = class of reserved word, 0 if strict operator
	token_class = operator class
	token_index = precedence level ;

INTEGER RES_ENTRY;

INTERNAL INTEGER PROCEDURE DECSTR(string VAL);
	BEGIN INTEGER L,M,U,I1,I2; STRING S1,S2;
	L←1; U←res_count;
	DO begin M←(U+L)/2;
	    CASE COMPEQU(rescode[M],VAL)+1 OF
		BEGIN
		[-1+1]	U←M-1;
		[0+1]	begin res_class←TCODES[M] DIV( (#OPERATORS+1)*#DTYPE);
				tokenclass←tcodeS[m] mod #dtype;
				tokenindex← (tcodeS[m] div #dtype) mod (#OPERATORS+1);
				RETURN(RES_ENTRY←M);
			end;
		[1+1]	L←M+1
		END;
	   end UNTIL L>U;
	res_class←tokenclass←tokenindex←0;
	RETURN(RES_ENTRY←0);
	END;

!	procedure parse itself;

INTERNAL RECURSIVE RPTR(EXPR$)PROCEDURE PARSE;
BEGIN "PARSER"
	INTEGER TXTPOS,INSTR;
	$$PCODE←NULL_RECORD;		! initialize at beginning of statement;
	IF !DEBUG AND ¬!!DEBUGGING THEN TXTPOS←LENGTH($CLNSAVE);
	NOEXPAND←FALSE;			! enable macro expansions ;
	GTOKEN;				! reads first token;
	STBEGIN←FALSE;			! acknowledge that no longer beginning
					  of statement;
	IF !DEBUG AND ¬!!DEBUGGING THEN 
	   IF ($COMPILE=0) THEN INSTR←INSTR_N←1 ELSE INSTR←INSTR_N←INSTR_N+1;
	IF "A"≤ TOKEN ≤"Z" THEN
IF res_class=0 THEN ASSIGNPROC
ELSE BEGIN "a"
	BOOLEAN INCR_COM;
	IF ($COMPILE≠0)AND(CCODES[RES_ENTRY] LAND #TOP) THEN
		ERROR(TOKEN,":: is a top level command only and cannot be used in compound statements");
	IF ($COMPILE=0)AND(CCODES[RES_ENTRY] LAND #NOTTOP) THEN
		ERROR(TOKEN,":: is valid only inside a block");
	IF (INCR_COM←CCODES[RES_ENTRY] LAND #CMPD) THEN $COMPILE←$COMPILE+1;
	IF CCODES[RES_ENTRY] LAND #NEXPND THEN NOEXPAND←TRUE;
	IF CCODES[RES_ENTRY] LAND #SEMICOL THEN SEMICOL_READ;
	if ccodes[res_entry] land #debug and ¬!!DEBUGGING then 
		error(token,":: is a debug command and is valid only in debug mode");
	   CASE res_class of
   	        BEGIN "CASE"
		redefine xx(#flag, str,oper)"[][]"=[
			ifc #flag thenc ; oper elsec ; notavailcall endc];
		redefine xxzz(#flag, str,oper,arg1,arg2)"[][]"=[
			 ; oper ];
		redefine zz(arg1,arg2,arg3)"[][]"=[];
		ASSIGNPROC
		tokencodes
	        END "CASE";
	IF INCR_COM THEN $COMPILE←$COMPILE-1;
     END "a"
ELSE IF TOKEN=";" OR TOKEN=NULL THEN
		BEGIN IF $COMPILE THEN STOKEN←TRUE END
ELSE IF TOKEN="?" THEN PRINT(#VERSION)
ELSE	IFC #ARROW THENC
	IF TOKEN="↑" THEN $ARROW←$ARROW+20 ELSE 
	IF TOKEN="↓" THEN $ARROW←$ARROW-20 ELSE 
	IF #TOKEN=INT_TYPE
	   THEN BEGIN
		INTEGER NUM;
		NUM←INTSCAN(TOKEN,$BRCHR);GTOKEN;
		IF TOKEN="↓" THEN $ARROW←$ARROW-NUM*20
		   ELSE IF TOKEN="↑" THEN $ARROW←$ARROW+NUM*20
		   ELSE	ERROR("unrecognized instruction");
		END
           ELSE ENDC 
		ERROR("ERROR: Can't begin statement with ",TOKEN);
IF !DEBUG AND ¬!!DEBUGGING
   THEN IF $$PCODE 
	   THEN $$PCODE←MARK(INSTR,TXTPOS) ELSE INSTR_N←INSTR_N - 1;
	IF NOT $COMPILE
	   THEN BEGIN "interpret it"
		$ALLOW←$ALLOW+1;
		IF !DEBUG AND ¬!!DEBUGGING AND $$PCODE THEN DBINIT;
		IF $$PCODE THEN $EXECUTE($$PCODE);
		$$PCODE←NULL_RECORD;
		$ALLOW←$ALLOW-1;
		IFC #DISPL THENC UPDATE; ENDC
		END;
	RETURN($$PCODE);
END "PARSER";
!	preparse;

INTERNAL PROCEDURE PREPARSE;
	BEGIN
	$COMPILE←0;		! set interpreter mode;
	$LEVEL←0;		! indicate it is top level ;
	$TMPOFF←$SYMOFF;	! reinitialize the maximum offset;
	CURPROC←NULL_RECORD;	! we are outside a procedure ;
	REFPROC←NULL_RECORD;	! this isn't a procedure call;
	CURBLOCK←NULL_RECORD;	! we are ouside a block ;
	STBEGIN←TRUE;		! waiting for a new command;
	$CLNSAVE←NULL;		! get rid of the saved string;
	$ERRCMON←FALSE;
	$ERRLEVEL←0;
	END;

END "PARSE";